home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE07 / CLINIC / TABLE2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-28  |  3.8 KB  |  128 lines
  1. unit Table2;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, DB, DBTables;
  8.  
  9. type
  10.   TCalcFieldsEvent =
  11.     procedure (DataSet: TDataSet; var DoDefault: Boolean) of object;
  12.  
  13.   TNewTable2 = class(TTable)
  14.   private
  15.     FOnCalcFields: TCalcFieldsEvent;
  16.     procedure OldOnCalcFields(DataSet: TDataSet);
  17.   public
  18.     constructor Create(AOwner: TComponent); override;
  19.     procedure MakeFields(const FieldNames: array of String);
  20.     procedure MakeCalculatedField(const FieldName: String;
  21.       DataType: TFieldType; Size: Word);
  22.   published
  23.     property OnCalcFields: TCalcFieldsEvent
  24.       read FOnCalcFields write FOnCalcFields;
  25.   end;
  26.  
  27. procedure Register;
  28.  
  29. implementation
  30.  
  31. constructor TNewTable2.Create(AOwner: TComponent);
  32. begin
  33.   inherited Create(AOwner);
  34.   DatabaseName := 'DBDEMOS';
  35.   TableName := 'CUSTOMER';
  36.   MakeFields(['Company', 'CustNo', 'TaxRate']);
  37.   MakeCalculatedField('Taxable', ftBoolean, 0);
  38.   inherited OnCalcFields := OldOnCalcFields;
  39. end;
  40.  
  41. procedure TNewTable2.MakeFields(const FieldNames: array of String);
  42. var
  43.   CopyTable: TTable;
  44.   Field, CopyField: TField;
  45.   Loop: Byte;
  46. begin
  47.   { Only make objects when asked by user }
  48.   { not when reading in from form stream }
  49.   if not (csLoading in Owner.ComponentState) then
  50.   begin
  51.     { Make normal table object (it will have all fields available }
  52.     { If we were to rely on this table, after the first field }
  53.     { object is added, we wouldn't see any other fields) }
  54.     CopyTable := TTable.Create(nil);
  55.     try
  56.       { Set up copy table properties and open it }
  57.       CopyTable.DatabaseName := DatabaseName;
  58.       CopyTable.TableName := TableName;
  59.       CopyTable.Open;
  60.       { Loop for each new field object }
  61.       for Loop := Low(FieldNames) to High(FieldNames) do
  62.       begin
  63.         { Find the normal run-time field }
  64.         CopyField := CopyTable.FieldByName(FieldNames[Loop]);
  65.         { Construct a new object of the appropriate class type }
  66.         { This is the thing which will end up in the Object Inspector }
  67.         Field := TFieldClass(CopyField.ClassType).Create(Owner);
  68.         { Tie it to a field }
  69.         Field.FieldName := FieldNames[Loop];
  70.         { Give the object a name }
  71.         Field.Name := Name + FieldNames[Loop];
  72.         { Set the size up correctly }
  73.         Field.Size := CopyField.Size;
  74.         { Insert the field in this table }
  75.         Field.DataSet := Self;
  76.       end;
  77.     finally
  78.       { Finished with the copy table now }
  79.       CopyTable.Free;
  80.     end;
  81.   end;
  82. end;
  83.  
  84. procedure TNewTable2.MakeCalculatedField(const FieldName: String;
  85.   DataType: TFieldType; Size: Word);
  86. var
  87.   Field: TField;
  88. begin
  89.   { Only make objects when asked by user }
  90.   { not when reading in from form stream }
  91.   if not (csLoading in Owner.ComponentState) then
  92.     { Use a field definition object to save code }
  93.     with TFieldDef.Create(nil, FieldName, DataType, Size, False, 0) do
  94.       try
  95.         { Make appropriate field object }
  96.         Field := CreateField(Owner);
  97.         Field.Calculated := True;
  98.         { Sort its name out, so it will appear in the Object Inspector }
  99.         Field.Name := Name;
  100.         { Insert it into the table's field list }
  101.         Field.DataSet := Self;
  102.       finally
  103.         Free;
  104.       end;
  105. end;
  106.  
  107. procedure TNewTable2.OldOnCalcFields(DataSet: TDataSet);
  108. var
  109.   DoDefault: Boolean;
  110. begin
  111.   DoDefault := True;
  112.   if Assigned(FOnCalcFields) then
  113.     FOnCalcFields(DataSet, DoDefault);
  114.   if DoDefault then
  115.   begin
  116.     { The calculated field calculation needs to be placed here }
  117.     FieldByName('Taxable').AsBoolean := FieldByName('TaxRate').AsFloat > 0;
  118.   end;
  119. end;
  120.  
  121. procedure Register;
  122. begin
  123.   RegisterComponents('Samples', [TNewTable2]);
  124. end;
  125.  
  126. end.
  127.  
  128.